perm filename B.F4[MSS,LCS] blob
sn#249496 filedate 1976-11-27 generic text, type T, neo UTF8
00010 C******* LOAD WITH EXT.FAI *******
00100 DIMENSION BARS(1),JBAR(1),JRN(1),MBAR(1)
00200 DATA QLINE/140.0/,HX/2./,SLSP/11.0/,DIV/4./
00300 C QLINE=BASIC LINE LENGTH, HX=HEIGHT MULTIPLIER, ZL=LN. LNGTH FACTOR.
00400
00500 COMMON /MNX/MIN,MAX,JT
00600 COMMON /FIN/LBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
00700 1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2
00800 COMMON /SF/KL,RT,KP,STFSZ,NAMX /IPG/IPG,JPG,BRACK,
00900 1 RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(-3/4) /KBAR/KBAR(512)
01000 1 /RSP/KNM(10),ENDLN,N,NAME,NMPG,T
01100 COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
01200 COMMON/STF/RSTFAC(-3/4),RSTJ2 /SIZE/SIZE
01300 COMMON /POSI/STFF(-3/4),JJ2,JPQ /LLL/L,LL,I,RXQ
01400 1/PX/KPN(300) /Q/Q(2001) /PTR/KWDS(300) /XRN/RN(2000)/NBAR/NBAR(36)
01500 EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(KT,KBAR)
01600 1,(R8,RQ(6)),(R9,RQ(7)),(JRN,RN),(MBAR,RN(1000))
01700 1,(TOT,KBAR(2)),(JBAR,BARS,KBAR(4))
01800 C TRNSP'S Bb, F, BBb, A, G, Eb.
01900 145 FORMAT(F,2I)
02000 CALL GETEXT('BARS','PAG')
02100 CALL EXTIN(KBAR,512)
02200 CALL EXTIN(RSTFAC,128)
02300 2000 TYPE 144,RSTJ2
02400 144 FORMAT(' STAFF SIZE='F4.2,' CHANGE TO '$)
02500 ACCEPT 145,SIZE,LPT
02600 IF(SIZE.NE.0)GO TO 101
02700 SIZE=1
02800 101 JTOT=0
02900 ITOT=0
03000 DO 22 K=1,KT
03100 JJ=BARS(K)*SIZE+.5
03200 ITOT=ITOT+JJ
03300 JBAR(K)=JJ
03400 22 JTOT=JTOT+JJ
03500 ITOT=TOT*SIZE
03600 33 IF(RSTJ2.EQ.0)RSTJ2=1
03700 RA=JPG*SIZE*RSTJ2
03800 MPG=10./RA
03900 C MPG=NUM OF BRACES PER PAGE.
04000 SPG=10./MPG
04100 C SPG IS SPACE TO BE SET ABOVE STAFF 0
04200 RA=(RSTJ2*SIZE)/RPSZ(1)
04300 DO 141 K=1,JPG
04400 141 RPSZ(K)=RPSZ(K)*RA
04500 LPG=JPG
04600
04700 140 TYPE 90,KT
04800 RA=0
04900 90 FORMAT(' TOTAL BAR LINES='I3/' NUMBER OF BARS PER LINE')
05000
05100 JT=ITOT/140
05200 C USE QLINE (140 FOR NOW) AS SUGGESTED LINE LENGTH
05300 16 NT=JT
05310 JDIF=0
05400 L=0
05500 KTOT=JTOT
05600 KAV=KTOT/JT
05700 LMIN=-1
05800 LMAX=10000
05900 NJ=0
06000 LJ=0
06100 LMM=-1
06200 LDIF=10000
06300 NBAR(1)=1
06400 J=1
06500 3 M=1
06600 JAV=KTOT/NT
06700 K=JBAR(J)
06800 1 J=J+1
06900 IF(J.GT.KT)GO TO 2
07000 N=JBAR(J)
07100 IF(K+N/2.GE.JAV)GO TO 2
07200 M=M+1
07300 K=K+N
07400 GO TO 1
07500 2 L=L+1
07600 KTOT=KTOT-K
07700 NT=NT-1
07800 JRN(L)=K
07900 NBAR(L+1)=J
08000 IF(NT.GT.0)GO TO 3
08100 5 MAX=0
08200 MIN=10000
08300
08400 DO 7 L=1,JT
08500 K=JRN(L)
08600 IF(K.LE.MAX)GO TO 6
08700 MAX=K
08800 MX=L
08900 6 IF(K.GE.MIN)GO TO 7
09000 MIN=K
09100 MN=L
09200 7 CONTINUE
09300
09400 J=MAX-MIN
09500 IF(MAX.GE.LMAX.AND.J.GE.LDIF)GO TO 9
09600 IF(MIN.GT.LMIN)LMIN=MIN
09700 IF(MAX.LT.LMAX)LMAX=MAX
09800 IF(J.LT.LDIF)LDIF=J
09900 CALL STORE(NBAR)
10000
10100 IF(MX.LT.MN)GO TO 32
10200 JJ=0
10300 JM=-1
10400 JK=1
10500 23 K=NBAR(MX+JJ)-JJ
10600 C NEXT RIPPLES THE BARS, FROM MAX TO MIN.
10700 MM=JBAR(K)
10800 JRN(MX)=JRN(MX)-MM
10900 JRN(MX+JM)=JRN(MX+JM)+MM
11000 NBAR(MX+JJ)=K+JK
11100 MX=MX+JM
11200 IF(JJ.NE.0)GO TO 223
11300 IF(MX.GT.MN)GO TO 23
11400 GO TO 5
11500 223 IF(MX.LT.MN)GO TO 23
11600 GO TO 5
11700 32 JJ=1
11800 JM=1
11900 JK=0
12000 GO TO 23
12100 9 CALL GET(NBAR,JBAR)
12200 IDIF=10000
12300 JJT=JT-1
12400 104 CALL MNMX(IDIF)
12500 108 DO 102 J=1,JJT
12600 IF(JRN(J).LE.KAV)GO TO 102
12700 C DON'T MAKE IT SMALLER IF IT'S ALREADY LESS THAN AVERAGE.
12800 I=NBAR(J+1)-1
12900 IF(I.EQ.NBAR(J))GO TO 102
13000 C WE'RE DOWN TO ONE BAR
13100 JJ=JRN(J)-JBAR(I)
13200 C SUBTRACT LAST BAR OF THIS LINE, ADD IT ON NEXT.
13300 IF(JJ.LT.MIN)GO TO 102
13400 KK=JRN(J+1)+JBAR(I)
13500 IF(KK.GT.MAX)GO TO 103
13600 C LET'S SEE IF FURTHER SHUFFLING WILL IMPROVE IT.
13700 CALL MINMAX
13800 105 JRN(J)=JJ
13900 JRN(J+1)=KK
14000 NBAR(J+1)=NBAR(J+1)-1
14100 GO TO 104
14200 103 IF(J.EQ.JJT)GO TO 102
14300 NN=KK
14400 DO 106 K=J+1,JJT
14500 LL=NBAR(K+1)-1
14600 C CHECK ON WHAT WILL HAPPEN TO NEXT LINE.
14700 MM=NN-JBAR(LL)
14800 IF(MM.LT.MIN.OR.MM.GT.MAX)GO TO 102
14900 NN=JBAR(LL)+JRN(K+1)
15000 106 IF(NN.LE.MAX)GO TO 105
15100 102 CONTINUE
15200 204 CALL MNMX(IDIF)
15300 208 DO 202 J=JT,2,-1
15400 IF(JRN(J).LE.KAV)GO TO 202
15500 C DON'T MAKE IT SMALLER IF IT'S ALREADY LESS THAN AVERAGE.
15600 I=NBAR(J)
15700 IF(I-1.EQ.NBAR(J-1))GO TO 202
15800 C WE'RE DOWN TO ONE BAR
15900 JJ=JRN(J)-JBAR(I)
16000 C SUBTRACT LAST BAR OF THIS LINE, ADD IT ON NEXT.
16100 IF(JJ.LT.MIN)GO TO 202
16200 KK=JRN(J-1)+JBAR(I)
16300 IF(KK.GT.MAX)GO TO 203
16400 C LET'S SEE IF FURTHER SHUFFLING WILL IMPROVE IT.
16500 CALL MINMAX
16600 205 JRN(J)=JJ
16700 JRN(J-1)=KK
16800 NBAR(J)=NBAR(J)+1
16900 GO TO 204
17000 203 IF(J.EQ.2)GO TO 202
17100 NN=KK
17200 DO 206 K=J-1,2,-1
17300 LL=NBAR(K)
17400 C CHECK ON WHAT WILL HAPPEN TO NEXT LINE.
17500 MM=NN-JBAR(LL)
17600 IF(MM.LT.MIN.OR.MM.GT.MAX)GO TO 202
17700 NN=JBAR(LL)+JRN(K-1)
17800 206 IF(NN.LE.MAX)GO TO 205
17900 202 CONTINUE
18000
18100 CALL MINMAX
18200 IDIF=MAX-MIN
18300 CALL STORE(NBAR)
18400 400 MX=MAX+5
18500 JR=1
18600 C JR = HOW MANY BARS TO RIPPLE
18700 I=MAX-MIN
18800 IF(I.GT.IDIF)GO TO 402
18900 CALL STORE(NBAR)
19000 IDIF=I
19100 402 DO 401 J=1,JT
19200 401 IF(JRN(J).EQ.MIN)GO TO 408
19300 C TRY RIPPLE EACH WAY FROM SMALLEST VALUE
19400 408 IF(J.EQ.JT)GO TO 508
19500 C RIPPLE FORWARD FIRST
19600 I=NBAR(J+1)
19700 JJ=JRN(J)+JBAR(I)
19800 IF(JJ.GT.MX)GO TO 508
19900 C SMALLEST ISN'T TOO BIG, NOW CHECK UP THE LINE.
20000 NN=JRN(J+1)-JBAR(I)
20100 IF(NN.LT.MIN)GO TO 404
20200 C IF WE GET HERE THERE HAS BEEN IMPROVEMENT
20300 JRN(J)=JJ
20400 JRN(J+1)=NN
20500 NBAR(J+1)=I+1
20600 CC NBAR(J+1)=NBAR(J+1)+1
20700 415 CALL MINMAX
20800 C NOW GO BACK AND TRY AGAIN.
20900 GO TO 400
21000
21100 405 JRN(J)=JJ
21200
21300 DO 422 IB=J+1,N
21400 LB=NBAR(IB)
21500 JB=JRN(IB)-JBAR(LB)
21600 NBAR(IB)=LB+1
21700 IF(JB.LT.MIN)GO TO 421
21800 JRN(IB)=JB
21900 GO TO 415
22000
22100 421 IBB=IB+1
22200 LC=NBAR(IBB)
22300 JB=JB+JBAR(LC)
22400 IF(JB.GT.MIN)GO TO 422
22500 C NOW ADD A SECOND BAR
22600 JRN(IBB)=JRN(IBB)-JBAR(LC)
22700 LC=LC+1
22800 JB=JB+JBAR(LC)
22900 NBAR(IBB)=LC
23000
23100 422 JRN(IB)=JB
23200 NBAR(IBB)=LC+1
23300 JRN(IBB)=JRN(IBB)-JBAR(LC)
23400 GO TO 415
23500 C NOW GO BACK AND TRY AGAIN.
23600
23700 404 IF(J.EQ.JJT)GO TO 508
23800 DO 406 N=J+1,JJT
23900 LL=NBAR(N+1)
24000 MM=NN+JBAR(LL)
24100 IF(MM.GT.MX)GO TO 508
24200 IF(MM.GT.MIN)GO TO 409
24300 C NEXT TO RIPPLE 2 BARS!
24400 412 MN=MM+JBAR(LL+1)
24500 C ADD ON A SECOND BAR
24600 IF(MN.GT.MX)GO TO 508
24700 C DON'T WORRY ABOUT IT BEING TOO SMALL (YET)
24800 NN=JRN(N+1)-JBAR(LL)-JBAR(LL+1)
24900 IF(NN.GT.MIN)GO TO 405
25000 GO TO 406
25100
25200 409 NN=JRN(N+1)-JBAR(LL)
25300 IF(NN.GE.MIN)GO TO 405
25400 406 CONTINUE
25500
25600 C TRY RIPPLE EACH WAY FROM SMALLEST VALUE
25700 508 IF(J.EQ.1)GO TO 502
25800 IF(J.EQ.LJ.AND.MX-MN.EQ.LMM)GO TO 502
25900 C THIS SHOULD AVOID GETTING INTO A LOOP
25910 IF(JDIF.EQ.IDIF)GO TO 150
25920 ICNT=0
25930 GO TO 151
25940 150 ICNT=ICNT+1
25950 IF(ICNT.EQ.10)GO TO 515
25960 151 JDIF=IDIF
26000 LJ=J
26100 LMM=MX-MN
26200 C RIPPLE BACK NOW
26300 I=NBAR(J)-1
26400 JJ=JRN(J)+JBAR(I)
26500 IF(JJ.GT.MX)GO TO 502
26600 C SMALLEST ISN'T TOO BIG, NOW CHECK UP THE LINE.
26700 NN=JRN(J-1)-JBAR(I)
26800 IF(NN.LT.MIN)GO TO 504
26900 C IF WE GET HERE THERE HAS BEEN IMPROVEMENT
27000 JRN(J)=JJ
27100 JRN(J-1)=NN
27200 NBAR(J)=I
27300 GO TO 415
27400 505 JRN(J)=JJ
27500 DO 522 IB=J-1,N,-1
27600 LB=NBAR(IB+1)-1
27700 JB=JRN(IB)-JBAR(LB)
27800 NBAR(IB+1)=LB
27900 IF(JB.LT.MIN)GO TO 521
28000 JRN(IB)=JB
28100 GO TO 415
28200 521 IBB=IB-1
28300 LC=NBAR(IB)-1
28400 JB=JB+JBAR(LC)
28500 IF(JB.GT.MIN)GO TO 522
28600 JB=JB+JBAR(LC-1)
28700 NBAR(IB)=LC
28800 JRN(IBB)=JRN(IBB)-JBAR(LC)
28900 CHECK THIS OUT!!
29000 LC=LC-1
29100 522 JRN(IB)=JB
29200 JRN(IBB)=JRN(IBB)-JBAR(LC)
29300 CC NBAR(IB)=NBAR(IB)-1
29400 NBAR(IB)=LC
29500 GO TO 415
29600 504 IF(J.LE.2)GO TO 502
29700 DO 506 N=J-1,2,-1
29800 LL=NBAR(N)-1
29900 MM=NN+JBAR(LL)
30000 IF(MM.GT.MX)GO TO 502
30100 IF(MM.GT.MIN)GO TO 509
30200 512 MN=MM+JBAR(LL-1)
30300 IF(MN.GT.MX)GO TO 502
30400 NN=JRN(N-1)-JBAR(LL)-JBAR(LL-1)
30500 IF(NN.GT.MIN)GO TO 505
30600 GO TO 506
30700 509 NN=JRN(N-1)-JBAR(LL)
30800 IF(NN.GE.MIN)GO TO 505
30900 506 CONTINUE
31000 502 IF(J.EQ.NJ.AND.MX-MN.EQ.LMM)GO TO 515
31100 C CHECK TO AVOID ENDLESS LOOP.
31200 NJ=J
31300 IF(J.EQ.JT)GO TO 515
31400 C LOOK FOR OTHER LINES = MIN.
31500 DO 510 K=J+1,JT
31600 IF(JRN(K).NE.MIN)GO TO 510
31700 J=K
31800 GO TO 408
31900 510 CONTINUE
32000
32100 515 CALL GET(NBAR,JBAR)
32200 13 DO 14 L=2,JT
32300 K=NBAR(L)
32400 MM=JRN(L)
32500 NN=JRN(L-1)
32600 IF(MM.GE.NN)GO TO 12
32700 C JUGGLES ADJACENT LINES
32800 N=JBAR(K-1)
32900 IF(NN-MM.LT.N)GO TO 14
33000 JRN(L-1)=NN-N
33100 JRN(L)=MM+N
33200 NBAR(L)=K-1
33300 GO TO 13
33400 12 N=JBAR(K)
33500 IF(MM-NN.LE.N)GO TO 14
33600 JRN(L-1)=NN+N
33700 JRN(L)=MM-N
33800 NBAR(L)=K+1
33900 GO TO 13
34000 14 CONTINUE
34100 46 J=1
34200 NBAR(JT+1)=KT+1
34300 JAV=JTOT/JT
34400 CALL MINMAX
34500 TYPE 308,JAV,MIN,MAX
34600 IF(LPT.NE.0)PRINT 308,JAV,MIN,MAX
34700 307 DO 305 K=1,JT
34800 NBAR(K)=NBAR(K+1)-NBAR(K)
34900 C NBAR NOW HAS NUM. OF BARS PER LINE.
35000 L=NBAR(K)-1+J
35100 306 FORMAT(I5,3X8I5)
35200 308 FORMAT(' AVG=',I3,' MIN=',I3,' MAX=',I3)
35300 TYPE 306,JRN(K),(JBAR(N),N=J,L)
35400 IF(LPT.NE.0)PRINT 306,JRN(K),(JBAR(N),N=J,L)
35500 305 J=L+1
35600 NBAR(JT+1)=0
35700
35800 RPG=JT
35900 RPG=RPG/MPG
36000 95 TYPE 94,RPG,JT
36100 IF(LPT.NE.0)PRINT 94,RPG,JT
36200 94 FORMAT(F5.2,' PAGES',/,I4,' LINES - OR TYPE N1, N2 --'$)
36300 C FOR SPECIFICATION OF HOW MANY BARS ON EACH LINE
36400 KA=0
36500 ACCEPT 145,T,N,KL
36600 C TYPE 0,n TO EXIT WITH n SPACING BETWEEN STAVES (2 IS DEFAULT)
36700 JT=T
36800 IF(N.EQ.0)GO TO 16
36900 C N=0 MEANS T= NUM OF LINES DESIRED.
37000 END
37100
37200 SUBROUTINE MINMAX
37300 COMMON /MNX/MIN,MAX,JT /XRN/JRN(1)
37400 MIN=10000
37500 MAX=0
37600 DO 107 K=1,JT
37700 NN=JRN(K)
37800 IF(NN.LT.MIN)MIN=NN
37900 107 IF(NN.GT.MAX)MAX=NN
38000 END
38100
38200 SUBROUTINE STORE(NBAR)
38300 COMMON /MNX/MIN,MAX,JT
38400 DIMENSION NBAR(1)
38500 COMMON /MB/MB(500)
38600 DO 1 K=2,JT+1
38700 1 MB(K)=NBAR(K)
38800 END
38900
39000 SUBROUTINE GET(NBAR,JBAR)
39100 COMMON /MNX/MIN,MAX,JT /XRN/JRN(1)
39200 DIMENSION NBAR(1),JBAR(1)
39300 COMMON /MB/MB(500)
39400 J=1
39500 DO 1 K=2,JT+1
39600 NBAR(K)=MB(K)
39700 N=0
39800 DO 2 L=J,MB(K)-1
39900 C FIX UP JRN ARRAY
40000 2 N=N+JBAR(L)
40100 JRN(K-1)=N
40200 1 J=MB(K)
40300 END
40400
40500 SUBROUTINE MNMX(IDIF)
40600 COMMON /MNX/MIN,MAX,JT /XRN/JRN(1)
40700 L=MIN
40800 N=MAX
40900 CALL MINMAX
41000 J=MAX-MIN
41100 IF(J.LE.IDIF)GO TO 1
41200 MIN=L
41300 MAX=N
41400 RETURN
41500 1 IDIF=J
41600 END